 Loading |
|
Loading |
| VBScript |
| JavaScript |
| Powershell |
Search Options: 2008 Scripting Games Sudden Death Event 3
|
||
|
' This is my Solution for the Scripting Games 2008
' For more Information look at ' http://www.microsoft.com/technet/scriptcenter/funzone/games/games08.mspx Option Explicit Dim ofso : Set ofso = Createobject("Scripting.FileSystemObject") Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 Call Main() ' --------------------------------------- Sub Main() Dim iCount, iCount2 Dim arrPresidents, arrPresidentsCalc(), arrTmpPresidents Dim strPresident, struChr, strABC, ivowels arrPresidents = ReadFileToArray("C:\Scripts\presidents.txt") If IsArray(arrPresidents) then ReDim arrPresidentsCalc(UBound(arrPresidents), 1) For iCount = 65 to 90 strABC = strABC & Chr(iCount) & "," Next For iCount = 0 to UBound(arrPresidents) If IsArray(arrTmpPresidents) then Erase arrTmpPresidents arrTmpPresidents = Split(arrPresidents(iCount), ",", -1, 1) For iCount2 = 0 to UBound(arrTmpPresidents) arrPresidentsCalc(iCount,iCount2) = arrTmpPresidents(iCount2) Next Next For iCount = 0 to UBound(arrPresidentsCalc) struChr = struChr & instrCheck("[A-Z]", arrPresidentsCalc(iCount,1) & arrPresidentsCalc(iCount,0)) ivowels = ivowels + instrCount("[a,e,i,o,u]", arrPresidentsCalc(iCount,1) & arrPresidentsCalc(iCount,0)) if Len(strPresident) < Len(arrPresidentsCalc(iCount,1)) then strPresident = arrPresidentsCalc(iCount,1) End if Next For iCount = 1 to Len(struChr) strABC = Replace(strABC, Mid(struChr,iCount,1) & ",", "", 1, -1, 1) Next strABC = Left(strABC,Len(strABC)-1) For iCount = 0 to UBound(arrPresidentsCalc) if arrPresidentsCalc(iCount,1) = strPresident then strPresident = arrPresidentsCalc(iCount,1) & " " & arrPresidentsCalc(iCount,0) Exit For End if Next wscript.echo "Longest first name: " & strPresident wscript.echo "These letters are not used as Presidential initials:" & vbcrlf & strABC wscript.echo "Total vowels used: " & ivowels End if End Sub ' --------------------------------------- Private Function ReadFileToArray(strFile) Dim strNextLine, arrstrList Dim arrLines() Dim iCount : iCount = 0 If ofso.FileExists(strFile) then Dim oFile : Set oFile = ofso.OpenTextFile(strFile, ForReading) Do Until oFile.AtEndOfStream Redim Preserve arrLines(iCount) arrLines(iCount) = oFile.ReadLine iCount = iCount + 1 Loop oFile.Close End if Set oFile = nothing If IsArray(arrLines) then ReadFileToArray = arrLines End Function ' --------------------------------------- Private Function instrCheck(strPattern, strSearch) Dim oRegEx : Set oRegEx = CreateObject("VBScript.RegExp") Dim colMatches, strMatch, strRet oRegEx.Global = True oRegEx.Pattern = strPattern Set colMatches = oRegEx.Execute(strSearch) If colMatches.Count > 0 Then For Each strMatch in colMatches strRet = strRet & strMatch Next instrCheck = strRet Else instrCheck = "" End if End Function ' --------------------------------------- Private Function instrCount(strPattern, strSearch) Dim oRegEx : Set oRegEx = CreateObject("VBScript.RegExp") Dim colMatches, strMatch oRegEx.Global = True oRegEx.IgnoreCase = True oRegEx.Pattern = strPattern Set colMatches = oRegEx.Execute(strSearch) If colMatches.Count > 0 Then instrCount = colMatches.Count Else instrCount = 0 End if End Function | ||
© 2008 - 2013 Boris Toll :: Scripts available: 6.481 :: :: scriptbox.toll.at :: :: powered by www.toll.at :: | ||
